*
* $Id$
*
#include "geant321/pilot.h"
*CMZ :  3.21/02 29/03/94  15.41.26  by  S.Giani
*-- Author :
      SUBROUTINE GDCGSL(IVOLNA,ISHAPE)
C.
C.    ******************************************************************
C.    *                                                                *
C.    *       This routine allows computes the coefficients of the     *
C.    *       cut plane and the limits and array of the clipping       *
C.    *       volumes (boxes, cones, tubes, spheres).                  *
C.    *                                                                *
C.    *    ==>Called by : G3DRAW                                        *
C.    *                                                                *
C.    *       Authors :  J.Salt ; S.Giani                              *
C.    ******************************************************************
C.
#include "geant321/gcdraw.inc"
#include "geant321/gcunit.inc"
#include "geant321/gconsp.inc"
#include "geant321/gcgobj.inc"
*
*
*****SG
*
#include "geant321/gcspee.inc"
#include "geant321/gcbank.inc"
#include "geant321/gcnum.inc"
#include "geant321/gcvolu.inc"
#include "geant321/gchiln.inc"
#include "geant321/gcmutr.inc"
#include "geant321/pawc.inc"
*
      DIMENSION TMIN(3),TMAX(3),XZ(2,4)
      CHARACTER*4 NACA
*
      CALL UCTOH('PERS',IPERS,4,4)
      IF(IHOLE.NE.0)THEN
*
*   Clipping Volumes Creation
*
*   Look for volume to be clipped
*
         NAIN=0
         JJJ=0
         ICUBE=0
         CALL UHTOC(IVOLNA,4,NACA,4)
         DO 30  III=1,MULTRA
            INV=0
            IWILDC=INDEX(GNNVV(III),'*')
            IF(IWILDC.EQ.0) THEN
               CALL UCTOH(GNNVV(III),INV,4,4)
            ELSEIF(IWILDC.EQ.1.AND.JJJ.LT.2) THEN
               INV=IVOLNA
            ELSEIF(GNNVV(III)(1:IWILDC-1).EQ.
     +                NACA(1:IWILDC-1)) THEN
               INV=IVOLNA
            ENDIF
            IF(INV.EQ.IVOLNA)THEN
*
*   If you find it, compute number of times it's to be clipped
*   and set parameters of relative clipping shapes
*
               JJJ=JJJ+1
               IF(JJJ.EQ.3)THEN
                  WRITE(CHMAIL,10100)
                  CALL GMAIL(0,0)
                  GOTO 60
               ENDIF
               IF(GNASH(III).EQ.'BOX ')THEN
                  DBX=GXMAX(III)-GXMIN(III)
                  DBY=GYMAX(III)-GYMIN(III)
                  DBZ=GZMAX(III)-GZMIN(III)
*
                  IF(JJJ.EQ.2)THEN
                     ICUBE=ICUBE+1
                     CALL CGBRIK(DBX,DBY,DBZ,300,Q(ICLIP2))
                     CALL CGCEV(-1,Q(ICLIP2))
                     CALL CGCEV(-1,Q(ICLIP2))
                     CALL CGSHIF(GXMIN(III),GYMIN(III),GZMIN(III),
     +               Q(ICLIP2))
                     CALL CGMNMX(Q(ICLIP2),TMIN,TMAX)
*   Perspective view
                     IF (IPRJ.EQ.IPERS) THEN
                        CALL CGPERS(Q(ICLIP2))
                     ENDIF
                  ELSE
                     ICUBE=ICUBE+1
                     CALL CGBRIK(DBX,DBY,DBZ,300,Q(ICLIP1))
                     CALL CGCEV(-1,Q(ICLIP1))
                     CALL CGCEV(-1,Q(ICLIP1))
                     CALL CGSHIF(GXMIN(III),GYMIN(III),GZMIN(III),
     +               Q(ICLIP1))
                     CALL CGMNMX(Q(ICLIP1),TMIN,TMAX)
*   Perspective view
                     IF (IPRJ.EQ.IPERS) THEN
                        CALL CGPERS(Q(ICLIP1))
                     ENDIF
                  ENDIF
               ELSE IF (GNASH(III).EQ.'TUBE') THEN
                  RMIN1=0
                  RMAX1=GXMIN(III)
                  Z2=GXMAX(III)
                  RMIN2=RMIN1
                  RMAX2=RMAX1
                  XZ(1,1)=RMIN1
                  XZ(2,1)=-Z2
                  XZ(1,2)=RMAX1
                  XZ(2,2)=-Z2
                  XZ(1,3)=RMAX2
                  XZ(2,3)=Z2
                  XZ(1,4)=RMIN2
                  XZ(2,4)=Z2
                  ANG1=0.
                  ANG2=360.
                  NANG=30
*
                  IF(JJJ.EQ.2)THEN
                     CALL CGZREV(XZ,ANG1,ANG2,NANG,16000,Q(ICLIP2))
                     CALL CGCEV(-1,Q(ICLIP2))
                     CALL CGCEV(-1,Q(ICLIP2))
                     S1=GYMIN(III)
                     S2=GYMAX(III)
                     S3=GZMIN(III)
                     CALL CGSHIF(S1,S2,S3,Q(ICLIP2))
                     CALL CGMNMX(Q(ICLIP2),TMIN,TMAX)
*   Perspective view
                     IF (IPRJ.EQ.IPERS) THEN
                        CALL CGPERS(Q(ICLIP2))
                     ENDIF
                  ELSE
                     CALL CGZREV(XZ,ANG1,ANG2,NANG,16000,Q(ICLIP1))
                     CALL CGCEV(-1,Q(ICLIP1))
                     CALL CGCEV(-1,Q(ICLIP1))
                     S1=GYMIN(III)
                     S2=GYMAX(III)
                     S3=GZMIN(III)
                     CALL CGSHIF(S1,S2,S3,Q(ICLIP1))
                     CALL CGMNMX(Q(ICLIP1),TMIN,TMAX)
*   Perspective view
                     IF (IPRJ.EQ.IPERS) THEN
                        CALL CGPERS(Q(ICLIP1))
                     ENDIF
                  ENDIF
               ELSE IF (GNASH(III).EQ.'SPHE') THEN
                  R=GXMIN(III)
                  NLAT=15
                  NLON=15
*
                  IF(JJJ.EQ.2)THEN
                     CALL CGSPHE(R,NLAT,NLON,16000,Q(ICLIP2))
                     CALL CGCEV(-1,Q(ICLIP2))
                     CALL CGCEV(-1,Q(ICLIP2))
                     S1=GXMAX(III)
                     S2=GYMIN(III)
                     S3=GYMAX(III)
                     CALL CGSHIF(S1,S2,S3,Q(ICLIP2))
                     CALL CGMNMX(Q(ICLIP2),TMIN,TMAX)
*   Perspective view
                     IF (IPRJ.EQ.IPERS) THEN
                        CALL CGPERS(Q(ICLIP2))
                     ENDIF
                  ELSE
                     CALL CGSPHE(R,NLAT,NLON,16000,Q(ICLIP1))
                     CALL CGCEV(-1,Q(ICLIP1))
                     CALL CGCEV(-1,Q(ICLIP1))
                     S1=GXMAX(III)
                     S2=GYMIN(III)
                     S3=GYMAX(III)
                     CALL CGSHIF(S1,S2,S3,Q(ICLIP1))
                     CALL CGMNMX(Q(ICLIP1),TMIN,TMAX)
*   Perspective view
                     IF (IPRJ.EQ.IPERS) THEN
                        CALL CGPERS(Q(ICLIP1))
                     ENDIF
                  ENDIF
               ELSE IF (GNASH(III).EQ.'CONE') THEN
                  RMIN1=0.
                  RMAX1=GXMIN(III)
                  RMIN2=0.
                  RMAX2=GXMAX(III)
                  Z2=GYMIN(III)
                  XZ(1,1)=RMIN1
                  XZ(2,1)=-Z2
                  XZ(1,2)=RMAX1
                  XZ(2,2)=-Z2
                  XZ(1,3)=RMAX2
                  XZ(2,3)=Z2
                  XZ(1,4)=RMIN2
                  XZ(2,4)=Z2
                  ANG1=0.
                  ANG2=360.
                  NANG=30
                  IF(JJJ.EQ.2)THEN
                     CALL CGZREV(XZ,ANG1,ANG2,NANG,16000,Q(ICLIP2))
                     CALL CGCEV(-1,Q(ICLIP2))
                     CALL CGCEV(-1,Q(ICLIP2))
                     S1=GYMAX(III)
                     S2=GZMIN(III)
                     S3=GZMAX(III)
                     CALL CGSHIF(S1,S2,S3,Q(ICLIP2))
                     CALL CGMNMX(Q(ICLIP2),TMIN,TMAX)
*   Perspective view
                     IF (IPRJ.EQ.IPERS) THEN
                        CALL CGPERS(Q(ICLIP2))
                     ENDIF
                  ELSE
                     CALL CGZREV(XZ,ANG1,ANG2,NANG,16000,Q(ICLIP1))
                     CALL CGCEV(-1,Q(ICLIP1))
                     CALL CGCEV(-1,Q(ICLIP1))
                     S1=GYMAX(III)
                     S2=GZMIN(III)
                     S3=GZMAX(III)
                     CALL CGSHIF(S1,S2,S3,Q(ICLIP1))
                     CALL CGMNMX(Q(ICLIP1),TMIN,TMAX)
*   Perspective view
                     IF (IPRJ.EQ.IPERS) THEN
                        CALL CGPERS(Q(ICLIP1))
                     ENDIF
                  ENDIF
               ENDIF
*          IF(CGERR.LE.0)THEN
*             CALL GDCGER(CGERR)
*             IF(KCGST.EQ.-2)GO TO 999
*             IF(KCGST.EQ.-3)THEN
*                WRITE(CHMAIL,10100)
*                CALL GMAIL(0,0)
*                GO TO 999
*             ENDIF
*          ENDIF
*
*    Compute scope for each clipping volume
*
               DO 10 K=1,3
                  KKK=K+3*JJJ-3
                  BMIN(KKK)=TMIN(K)
                  BMAX(KKK)=TMAX(K)
   10          CONTINUE
               IF(IPORLI.EQ.1)THEN
                  DO 20 KJ=1,3
                     KKKJ=KJ+3*JJJ-3
                     CLIPMI(KKKJ)=TMIN(KJ)
                     CLIPMA(KKKJ)=TMAX(KJ)
   20             CONTINUE
               ENDIF
            ENDIF
   30    CONTINUE
*
*    If volume is not to be clipped
*
         IF(JJJ.EQ.0)THEN
            IF(IPORLI.EQ.1)THEN
               DO 40 KJ=1,6
                  CLIPMI(KJ)=-10000
                  CLIPMA(KJ)=-9999
   40          CONTINUE
               JPORJJ=1
            ENDIF
            NAIN=1
            GOTO 60
         ELSE
            IF(IPORLI.EQ.1)THEN
               JPORJJ=JJJ
            ENDIF
            NAIN=2
            ISA=0
            DO 50  J=1,6
               IF(BMIN(J).EQ.CLIPMI(J).AND.BMAX(J).EQ.CLIPMA(J))THEN
                  ISA=ISA+1
               ENDIF
   50       CONTINUE
            IF(ISA.EQ.6)NAIN=3
         ENDIF
*
*
*****SG
*
*
      ELSE
*
*   Slicing with a plane
*
         IF(ICUT.EQ.0) GO TO 999
         IF(ICUT.EQ.1)THEN
            CTHETA=90.
            CPHI=180.
         ELSE IF(ICUT.EQ.2)THEN
            CTHETA=90.
            CPHI=270.
         ELSE IF(ICUT.EQ.3)THEN
            CTHETA=180.
            CPHI=0.
         ELSE
            WRITE(CHMAIL,10000)
            CALL GMAIL(0,0)
            GO TO 999
         ENDIF
         ATH=DEGRAD*CTHETA
         APH=DEGRAD*CPHI
         ABCD(1)=SIN(ATH)*COS(APH)
         ABCD(2)=SIN(ATH)*SIN(APH)
         ABCD(3)=COS(ATH)
         ABCD(4)=DCUT
      ENDIF
   60 CONTINUE
*
10000 FORMAT(' CUT Index not implemented')
*10100 FORMAT(' Check Clipping Box Parameters ')
10100 FORMAT(' Please, reset CVOL mode. ')
*
  999 END
